home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / JARexx / tests / VarTest.f < prev   
Encoding:
FORTH Source  |  1992-01-25  |  2.1 KB  |  98 lines
  1. \ A test program to demonstrate the direct variable interface to ARexx.
  2. \  Opens a public port called "VarTest" and then waits for REXX messages.
  3. \  The port stays open until a "CLOSE" command is received.
  4. \  Usage:  vartest            ( from Forth window )
  5. \          rx testrvi.rexx    ( from shell window )
  6. \  Then send commands from within ARexx by "address 'VarTest' command"
  7. \ 
  8. \ This version translated to JFORTH by Martin C Kees
  9.  
  10. \ 00001 PLB 1/24/92 Added INCLUDE? VALUE
  11.  
  12. getmodule includes
  13. getmodule arexxmod
  14. include? createport() ju:exec_support
  15. include? rexxsyslib?  jrx:ArexxCalls.f
  16. include? CheckRexxMsg jrx:RexxVars.f
  17. include? value        ju:value
  18.  
  19. anew TASK_VARTEST.F
  20.  
  21. 0 value VARTESTPORT
  22. 0 value RMSG
  23.  
  24. : VARPORT.INIT ( -- ok? )
  25.     0" VarTest" 0 createport()
  26.     dup -> vartestport
  27. ;  
  28.  
  29. : VARPORT.TERM ( -- )
  30.     vartestport dup
  31.     IF
  32.         deleteport()
  33.         0 -> vartestport
  34.     THEN    
  35. ;                  
  36.  
  37. : VARTEST.SHOWVAR ( 0name -- , show value of variable )
  38.     >r
  39.     rmsg r@ GetRexxVar ?dup
  40.     ." Vartest: value of " r> 0count type ."  is: "
  41.     IF \ error!
  42.         ." No Value" cr
  43.         ." VarTest: error from get " .
  44.         drop
  45.     ELSE
  46.         0count dup  
  47.         IF type 
  48.         ELSE ddrop ." NULL STRING"
  49.         THEN
  50.     THEN cr
  51. ;
  52.  
  53. : VARTEST  ( -- , test variable interface )
  54. \ initialize
  55.     rexxsyslib?
  56.     varport.init
  57.     IF
  58.         ." Waiting for commands from TestRVI.rexx" cr
  59.         BEGIN
  60. \ get command message from ARexx
  61.             vartestport waitport() drop
  62.             vartestport getMsg() -> rmsg
  63.             cr ." VarTest: received command "
  64.             rmsg .. rm_args @ >rel 0count type cr
  65.             rmsg CheckRexxMsg
  66.             IF
  67.                 ." VarTest: valid REXX context" cr
  68. \
  69. \ get variables and print them
  70.                 0" A.1" vartest.showvar
  71.                 0" A.2" vartest.showvar
  72. \
  73. \ change value of STATUS variable
  74.                 rmsg 0" STATUS" " A-OK" count
  75.                 SetRexxVar ?dup
  76.                 IF ." VarTest: error from set " . cr
  77.                 THEN
  78.             THEN
  79. \
  80. \ did we get CLOSE command?
  81.             0" CLOSE" 0count rmsg .. rm_args @ >rel text=?
  82. \
  83. \ reply to message
  84.             0 rmsg ..! rm_result1
  85.             0 rmsg ..! rm_result2
  86.             rmsg ReplyMsg()
  87.         UNTIL
  88. \ cleanup
  89.         varport.term
  90.     THEN
  91.     -rexxsyslib
  92. ;     
  93.  
  94. cr
  95. ." Enter in JForth:  VARTEST" cr
  96. ." Enter in shell:   RX JRX:TESTS/TestRVI" cr
  97.  
  98.